Attribute VB_Name = "modFunctions"
Option Explicit
Public adoConn As ADODB.Connection
Public objStrConn As Object
Public strConnString As String

Public Type TrackingVariables
    ComId As String
    BuId As String
    ReferenceID As String
    ReqSeqNum As String
    RequestStatus As String
    MsgId As String
End Type
'Public Tracking As TrackingVariables

Public Type RequestorVariables
    Date As String
    Time As String
    Name As String
    UserId As String
    Email As String
End Type
'Public Request As RequestorVariables

Public Type IndexVariables
    InterfaceNo As Long
    XMLString As String
    CreatedDated As String
    SarsResponseYn As String
    KeyTaxType As String
    MqStatus As String
    Form_Request_Type As String
    Tracking As TrackingVariables
    Request As RequestorVariables
End Type

Public IdxVars As IndexVariables

Public Type ErrorVAriables
    Code As String
    Reason As String
    Text As String
    Line As String
End Type
Public FileFmtErrVars As ErrorVAriables

Public objFunctions As clsFunctions
Public objReg As clsReg
Public objSendEMail As clsSendEMail

Public strCurrentLogFileName As String
Public lngIdxFileCount As Long
Public lngCounter As Long
Public strCurrentEnvironment As String

'Registry Function Prototypes
Declare Function RegOpenKeyEx Lib "advapi32" _
  Alias "RegOpenKeyExA" ( _
  ByVal hKey As Long, _
  ByVal lpSubKey As String, _
  ByVal ulOptions As Long, _
  ByVal samDesired As Long, _
  phkResult As Long _
) As Long

Declare Function RegQueryValueEx Lib "advapi32" _
  Alias "RegQueryValueExA" ( _
  ByVal hKey As Long, _
  ByVal lpValueName As String, _
  ByVal lpReserved As Long, _
  ByRef lpType As Long, _
  ByVal szData As String, _
  ByRef lpcbData As Long _
) As Long

Declare Function RegCloseKey Lib "advapi32" ( _
  ByVal hKey As Long _
) As Long

Type TSECURITY_ATTRIBUTES
  nLength As Long
  lpSecurityDescriptor As Long
  bInheritHandle As Boolean
End Type

Declare Function RegCreateKeyEx Lib "advapi32" _
  Alias "RegCreateKeyExA" ( _
  ByVal hKey As Long, _
  ByVal lpSubKey As String, _
  ByVal Reserved As Long, _
  ByVal lpClass As String, _
  ByVal dwOptions As Long, _
  ByVal samDesired As Long, _
  lpSecurityAttributes As TSECURITY_ATTRIBUTES, _
  phkResult As Long, _
  lpdwDisposition As Long _
) As Long

Declare Function RegSetValueEx Lib "advapi32" _
  Alias "RegSetValueExA" ( _
  ByVal hKey As Long, _
  ByVal lpValueName As String, _
  ByVal Reserved As Long, _
  ByVal dwType As Long, _
  ByVal szData As String, _
  ByVal cbData As Long _
) As Long


'********************************************************************************************************
'##ModelId=3521FD15008C
Declare Function RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" (ByVal hKey As Long, ByVal lpSubKey As String) As Long

'##ModelId=3521FD1602DA
Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal hKey As Long, ByVal lpValueName As String) As Long


Public Function ConnectToDb(strErrMsg As String) As Boolean

    On Error GoTo ConnectToDbFix
    
    Set adoConn = New ADODB.Connection
    With adoConn
        .CursorLocation = adUseClient
        .ConnectionString = GetConnectionString() 'Johann (20090625): Centralised code for connection string added
    End With
    
    adoConn.open
    ConnectToDb = True

    Exit Function
    
ConnectToDbFix:
    strErrMsg = Err.Description
    ConnectToDb = False
End Function
Public Sub Oracle_Disconnect()

    adoConn.Close

End Sub
Public Function LeftPad(PadStr As String, PadChar As String, PadLen As Integer) As String

    While Len(PadStr) < PadLen
        PadStr = PadChar & PadStr
    Wend
    LeftPad = PadStr
    
End Function
Public Function ImageUptime() As Boolean

    Dim strCurrentTime As String
    Dim strUptimeStarts As String
    Dim strUptimeEnds As String
        
    Select Case DatePart("w", Now)
        Case 1  '"SUNDAY"
            strUptimeStarts = objReg.GetDayStart("1")
            strUptimeEnds = objReg.GetDayEnd("1")
        Case 2  '"MONDAY"
            strUptimeStarts = objReg.GetDayStart("2")
            strUptimeEnds = objReg.GetDayEnd("2")
        Case 3  '"TUESDAY"
            strUptimeStarts = objReg.GetDayStart("3")
            strUptimeEnds = objReg.GetDayEnd("3")
        Case 4  '"WEDNESDAY"
            strUptimeStarts = objReg.GetDayStart("4")
            strUptimeEnds = objReg.GetDayEnd("4")
        Case 5  '"THURSDAY"
            strUptimeStarts = objReg.GetDayStart("5")
            strUptimeEnds = objReg.GetDayEnd("5")
        Case 6  '"FRIDAY"
            strUptimeStarts = objReg.GetDayStart("6")
            strUptimeEnds = objReg.GetDayEnd("6")
        Case 7  '"SATURDAY"
            strUptimeStarts = objReg.GetDayStart("7")
            strUptimeEnds = objReg.GetDayEnd("7")
    End Select

    strCurrentTime = Format(Time, "hhmm")
        
    If CLng(strCurrentTime) > CLng(strUptimeStarts) Then
        If CLng(strCurrentTime) <= CLng(strUptimeEnds) Then
            ImageUptime = True
        Else
            ImageUptime = False
        End If
    Else
        ImageUptime = False
    End If
    
    'shane:change back
    ImageUptime = True
    
End Function

Public Sub WriteToErr(strMsg As String, ByRef strFileName As String)

    Dim intFreeFile As Integer
    Dim strHeaderString As String
    
    'On Error GoTo WriteToLogFix
    On Error Resume Next
    'MsgBox "Error: " & strMsg
        
    If lngIdxFileCount = 0 Then
        'if this is the first idx file in the batch of this poll
        'then get the last seq no from reg and incr val in reg by 1
        GetNextLogFileName
    End If
    
    'strHeaderString = lngIdxFileCount + 1 & " Index files processed."
    'text = 23
    'max lngIdxFileCount = 10 digits
    'max strheader = 35
    
    'left just
    strHeaderString = Format(strHeaderString, "!" & String(35, "@"))
    'right just
    'strHeaderString = Format(strHeaderString, String(35, "@"))
    
    If Len(Trim(strCurrentLogFileName)) = 0 Then Call GetNextLogFileName
    
    strFileName = objReg.LogFilePath & strCurrentLogFileName
    'change from log to err
    strFileName = Left(strFileName, Len(strFileName) - 3)
    strFileName = strFileName & "err"
              
    strMsg = strMsg & " (" & Now & ")"

    AddErrorMessage (strHeaderString & ". " & strMsg)

     'open/write to file
    intFreeFile = FreeFile
    Open strFileName For Binary Access Write As #intFreeFile
        Put #intFreeFile, , strHeaderString
    Close #intFreeFile
    
    Open strFileName For Append As #intFreeFile
        If lngIdxFileCount = 0 Then
            Print #intFreeFile,  'get to next to next line after header
        End If
        Print #intFreeFile, strMsg
    Close #intFreeFile

    objSendEMail.SendErrorEmail strMsg

    objReg.LogErrors = 1
    CheckForErrors
    
    Exit Sub
    
WriteToLogFix:
    AddErrorMessage (Err.Number & Err.Description)
End Sub
Public Sub GetNextLogFileName()
    
    Dim lngSeqNo As Long
    Dim strEnvr As String
    
    lngSeqNo = objReg.LogFileSeq
    lngSeqNo = lngSeqNo + 1
    
    Select Case strCurrentEnvironment
        Case "Dev"
            strEnvr = "D"
        Case Else '"Prod1","Prod2","Prod3" etc
            strEnvr = Right(strCurrentEnvironment, 1)
    End Select
    
    strCurrentLogFileName = "KT" & strEnvr & LeftPad(CStr(lngSeqNo), "0", 5) & ".log"

    objReg.LogFileSeq = lngSeqNo

End Sub
Private Sub DisplayProgress(strFileCount As String, strCurrentFile As String)

    frmPoll.lblFileCount.Caption = strFileCount
    frmPoll.lstProgress.AddItem strCurrentFile, frmPoll.lstProgress.ListCount
    frmPoll.lstProgress.ListIndex = frmPoll.lstProgress.ListCount - 1
    frmPoll.Refresh

End Sub

Public Sub ClearScreenProgress()

    frmPoll.Caption = "KeyTax: Receive XML"
    frmPoll.lblFileCount.Caption = "Waiting . . . . ."
    frmPoll.lstProgress.Clear
    frmPoll.lstErrors.Clear
    frmPoll.Refresh

End Sub

Public Function CheckForErrors()

    Dim strErrPath As String

    strErrPath = objReg.LogFilePath & "Errors"

    'DETERMINING WHICH LIGHT BULB PICTURE TO DISPLAY (ARE THERE ERRORS OR NOT)
    
    If objReg.LogErrors = 1 Then
        frmPoll.cmdErrors.Picture = LoadPicture(App.Path & "\mis.ico")
        If Dir$(strErrPath) <> "" Then
            'errors have occurred
            frmPoll.blnErrorsViewed = False
            frmPoll.cmdErrors.Enabled = True
        Else
            frmPoll.cmdErrors.Picture = LoadPicture(App.Path & "\happy.ico")
            frmPoll.cmdErrors.Enabled = False
        End If
    Else
        frmPoll.cmdErrors.Picture = LoadPicture(App.Path & "\happy.ico")
        frmPoll.cmdErrors.Enabled = False
    End If

End Function
Public Sub SaveLastRunDttm()

    Dim rsDttm As ADODB.Recordset
    
    On Error GoTo SaveLastRunDttmFix
    
    If lngIdxFileCount > 0 Then
        'Set rsDttm = adoConn.openrecordset("Select SYSDATE from DUAL")
        'Set rsDttm = adoConn.openrecordset("select GETDATE()")
        'objReg.LastRunDttm = rsDttm(0)
        objReg.LastRunDttm = Now
    End If
    
    Exit Sub
    
SaveLastRunDttmFix:
    If Err.Number <> 91 Then
        AddErrorMessage ("SaveLastRunDttm: " & Err.Number & " - " & Err.Description)
    Else
        'lost connection to db, use PC date time
        objReg.LastRunDttm = Now
    End If
End Sub
Public Function ValidateFolder(ByRef strFolderToValidate As String, Optional blnGetPermission As Boolean) As Boolean

    Dim strDirExists As String
    Dim strAnswer As String

    On Error GoTo ValidateFolderFix

    If Dir(strFolderToValidate, vbDirectory) = "" Then
        Screen.MousePointer = vbDefault
        If blnGetPermission = True Then
            strAnswer = MsgBox("Directory: " & strFolderToValidate & " does not exist. " & Chr(10) & _
                    "Do you want create it?", vbYesNo, "Receive XML")
        Else
            strAnswer = vbYes
        End If
        If strAnswer = vbYes Then
            CreateFolder strFolderToValidate
            ValidateFolder = True
        Else
            ValidateFolder = False
            Exit Function
        End If
    End If
    If Len(strFolderToValidate) < 1 Then
        strFolderToValidate = ""
        ValidateFolder = False
        Exit Function
    End If
    
    If Right(strFolderToValidate, 1) <> "\" Then
        strFolderToValidate = strFolderToValidate & "\"
    End If
    ValidateFolder = True
    
    Exit Function
    
ValidateFolderFix:
    AddErrorMessage ("ValidateFolder: " & Err.Number & " - " & Err.Description)
    ValidateFolder = False
End Function

Public Sub CreateFolder(strFolder)

    Dim intPos As Integer
    Dim strTemp As String
    
    If Dir(strFolder, vbDirectory) = "" Then
        If Right(strFolder, 1) <> "\" Then
            strFolder = strFolder & "\"
        End If
        intPos = InStr(1, strFolder, "\")
        strTemp = Left(strFolder, intPos)
        Do While intPos <> 0
            If Dir(strTemp, vbDirectory) = "" Then
                MkDir strTemp
            End If
            intPos = InStr(intPos + 1, strFolder, "\")
            strTemp = Left(strFolder, intPos)
        Loop
    End If

End Sub
Public Function CheckTimeInterval(strTimeInt As String) As Boolean
'   This function validates the time interval entered

    If Len(strTimeInt) <> 0 Then
        If IsNumeric(strTimeInt) Then
            CheckTimeInterval = True
        Else
            CheckTimeInterval = False
        End If
    Else
        CheckTimeInterval = False
    End If

End Function


Public Function ReplaceTESTRefs(ByVal XMLString As String) As String
    Dim sReturnValue As String
    Dim RegSettings As clsReg
    Dim DTDLocation As String
    
    Set RegSettings = New clsReg
    sReturnValue = XMLString
       
    If RegSettings.DebugMode = "Y" Then
        'sReturnValue = Replace(sReturnValue, "LCB01", "LCB")
        'sReturnValue = Replace(sReturnValue, "LCB02", "LCB")
        'sReturnValue = Replace(sReturnValue, "LCB03", "LCB")
        
        DTDLocation = RegSettings.DTDLocation
        
        If Len(DTDLocation) > 0 Then
            'if the string hasn't been fixed already, fix it
            If Not InStr(sReturnValue, DTDLocation) > 0 Then
                sReturnValue = Replace(sReturnValue, "CancelRequest.dtd", DTDLocation & "CancelRequest.dtd")
                sReturnValue = Replace(sReturnValue, "FormB_Request.dtd", DTDLocation & "FormB_Request.dtd")
                sReturnValue = Replace(sReturnValue, "FormAD_Request.dtd", DTDLocation & "FormAD_Request.dtd")
            End If
        End If
    End If
    
    Set RegSettings = Nothing
    ReplaceTESTRefs = sReturnValue
End Function

Public Sub AddProgressMessage(MessageText As String)
    frmPoll.lstProgress.AddItem Now & vbTab & MessageText, 0
    frmPoll.Refresh
End Sub

Public Sub AddErrorMessage(MessageText As String)
    frmPoll.lstErrors.AddItem Now & vbTab & MessageText, 0
    frmPoll.Refresh
End Sub

